home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / BPTREES1.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  4KB  |  156 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program BpTrees1;
  9.  
  10. {$X+}
  11.  
  12. { Sample program for creating a B+ tree. }
  13.  
  14. uses Objects, Containr, ctBpTree,
  15.      {$ifdef Windows}
  16.      WinCtr;
  17.      {$else}
  18.      Crt;
  19.      {$endif}
  20.  
  21. type
  22.   PContact = ^TContact;
  23.   TContact = record
  24.     FirstName : string[15];
  25.     LastName : string[20];
  26.     Phone : string[18];
  27.     Company : string [25];
  28.   end; { TContact }
  29.  
  30. type
  31.   PContactList = ^TContactList;
  32.   TContactList = object(TBPlusTree)
  33.     function KeyOf(Item : Pointer) : Pointer; virtual;
  34.   end; { TContactList }
  35.  
  36. function TContactList.KeyOf(Item : Pointer) : Pointer;
  37. begin
  38.   KeyOf := @PContact(Item)^.LastName;
  39. end;
  40.  
  41. procedure SetContactValues(ALastName, AFirstName, APhone,
  42.   ACompany : string; var ContactRec : TContact);
  43. begin
  44.   with ContactRec do
  45.   begin
  46.     FirstName := AFirstName;
  47.     LastName := ALastName;
  48.     Phone := APhone;
  49.     Company := ACompany;
  50.   end; { with }
  51. end;
  52.  
  53. procedure DisplayContacts(ContactList : PGraph);
  54.  
  55.   procedure PrintInfo (Item : Pointer); far;
  56.   begin
  57.     with PContact(Item)^ do
  58.       writeln(LastName, '':15 - Length(LastName),
  59.         FirstName, '':15 - Length(FirstName),
  60.         Phone, '':20 - Length(Phone),
  61.         Company, '':20 - Length(Company));
  62.   end;
  63.  
  64. begin
  65.   ContactList^.ForEach(@PrintInfo);
  66. end;
  67.  
  68. procedure DisplayFirst(ContactList : PGraph);
  69. var
  70.   Item : Pointer;
  71. begin
  72.   Item := ContactList^.First;
  73.   Writeln('First item:');
  74.   with PContact(Item)^ do
  75.     writeln(LastName, '':15 - Length(LastName),
  76.       FirstName, '':15 - Length(FirstName),
  77.       Phone, '':20 - Length(Phone),
  78.       Company, '':20 - Length(Company));
  79.   ContactList^.DoneItem(Item); { not required }
  80. end;
  81.  
  82. procedure DisplayLast(ContactList : PGraph);
  83. var
  84.   Item : Pointer;
  85. begin
  86.   Item := ContactList^.Last;
  87.   Writeln('Last item:');
  88.   with PContact(Item)^ do
  89.     writeln(LastName, '':15 - Length(LastName),
  90.       FirstName, '':15 - Length(FirstName),
  91.       Phone, '':20 - Length(Phone),
  92.       Company, '':20 - Length(Company));
  93.   ContactList^.DoneItem(Item); { not required }
  94. end;
  95.  
  96. procedure FindLastName(ContactList : PGraph; LastName : string);
  97. var
  98.   Item : Pointer;
  99. begin
  100.   Item := ContactList^.KeyFirst(@LastName);
  101.   Writeln('Item found with last name ''', LastName, ''':');
  102.   with PContact(Item)^ do
  103.     writeln(LastName, '':15 - Length(LastName),
  104.       FirstName, '':15 - Length(FirstName),
  105.       Phone, '':20 - Length(Phone),
  106.       Company, '':20 - Length(Company));
  107.   ContactList^.DoneItem(Item); { not required }
  108. end;
  109.  
  110. var
  111.   ContactList : PContactList;
  112.   Contact : TContact;
  113.   Stream : PBufStream;
  114.  
  115. begin
  116.   ClrScr;
  117.  
  118.   { Create the stream }
  119.   Stream := New(PBufStream, Init('btrees.dat', stCreate, 1024));
  120.  
  121.   { Create the B tree }
  122.   ContactList := New(PContactList, Init(2, 3, SizeOf(TContact),
  123.     20, Stream, 5, 2));
  124.  
  125.   { Insert the items in the B tree }
  126.   with ContactList^ do
  127.   begin
  128.     SetContactValues('Lewis', 'Carl', '(506) 83-780', 'Running, Corp.',
  129.       Contact);
  130.     Insert(@Contact);
  131.     SetContactValues('Benton', 'Michael', '(403) 33-973', 'ER, Inc.',
  132.       Contact);
  133.     Insert(@Contact);
  134.     SetContactValues('Wagner', 'Robert', '(906) 11-230', 'Symphony, Ltd.',
  135.       Contact);
  136.     Insert(@Contact);
  137.     SetContactValues('Smith', 'John', '(656) 75-843', 'InterComm, Corp.',
  138.       Contact);
  139.     Insert(@Contact);
  140.   end; { with }
  141.  
  142.   DisplayContacts(ContactList);
  143.   Writeln;
  144.   DisplayFirst(ContactList);
  145.   Writeln;
  146.   DisplayLast(ContactList);
  147.   Writeln;
  148.   FindLastName(ContactList, 'Wagner');
  149.  
  150.   { Dispose of the B tree }
  151.   Dispose(ContactList, Done);
  152.  
  153.   { Dispose of the stream }
  154.   Dispose(Stream, Done);
  155. end.
  156.